PROGRAM TWOWAYCOUPLING_EMULATOR

IMPLICIT NONE

INTEGER, PARAMETER :: FB = SELECTED_REAL_KIND(6)

CHARACTER(256) CHID,QFILE,EXECUTABLE
CHARACTER(1) OP_SYS

INTEGER COUNTER,VAR
REAL, ALLOCATABLE, DIMENSION(:,:) :: VERTS,TFACES,NEWVERTS
INTEGER, ALLOCATABLE, DIMENSION(:) :: SURF_IDS,MATL_IDS
INTEGER, ALLOCATABLE, DIMENSION(:,:) :: FACES,VOLUS

REAL(FB) TIME,TIMEGEOM
INTEGER OWNER_INDEX,I,J
INTEGER ONE_INTEGER,VERSION,N_FLOATS,N_INTS,FIRST_FRAME_STATIC,N_FACES,N_VERTS,N_VOLUS
INTEGER :: ONE=1

REAL(FB) :: DUMMY
INTEGER :: IDUMMY

COUNTER=10

CHID='tetra_1'
CALL GETARG(1,EXECUTABLE)
CALL GETARG(2,OP_SYS)
IF (OP_SYS=='W') THEN
  CALL SYSTEMQQ ('start /b '//TRIM(EXECUTABLE)//' '//TRIM(CHID)//'.fds')
ELSE
  CALL SYSTEMQQ (TRIM(EXECUTABLE)//' '//TRIM(CHID)//'.fds &')
ENDIF

OPEN(10,FILE=TRIM(CHID)//'.gc',ACTION='WRITE',FORM='UNFORMATTED')
OWNER_INDEX=0
WRITE(10) OWNER_INDEX
CLOSE(10) 

!VARIABLE_NUMBER: DO VAR=1,VARIABLE
VAR=1
! 500 - Point of the loop in case of the point does not reach a meaning value - SILVA, JC         
500 CONTINUE

TIME_LOOP: DO TIMEGEOM=2,10,2

! wait for FDS flag
BOUNDARY_CHECK_LOOP: DO I=1,600
   OPEN(10,FILE=TRIM(CHID)//'.gc',ACTION='READ',FORM='UNFORMATTED')
   READ(10) OWNER_INDEX
   IF (OWNER_INDEX/=2) THEN
      CLOSE(10)
      IF (I==1) WRITE (6,'(4X,A)')  'waiting for FDS results ... '
      CALL SLEEP(15)
      IF (I==600) THEN
         WRITE (6,*) 'ERROR: .be FILE WAS NOT UPDATED BY FDS'
         STOP
      ENDIF
   ELSEIF (OWNER_INDEX==2) THEN
      CLOSE(10)
      EXIT BOUNDARY_CHECK_LOOP
   ENDIF
ENDDO BOUNDARY_CHECK_LOOP

! Read in geometry file generated by FDS.
! Since we are changing geometry dynamically we need look for geometry in
! the first time step of the "dynamic" portion of the geometry file

QFILE='tetra_1_01.ge'
OPEN(12+VAR,FILE=QFILE,FORM='UNFORMATTED',STATUS='OLD')

! read header

READ(12+VAR) ONE_INTEGER
READ(12+VAR) VERSION
READ(12+VAR) N_FLOATS, N_INTS, FIRST_FRAME_STATIC

! read and ignore static frame if present

READ(12+VAR) TIME
READ(12+VAR) N_VERTS, N_FACES, N_VOLUS
IF (N_VERTS>0) READ(12+VAR) (DUMMY,J=1,3*N_VERTS)
IF (N_FACES>0) THEN
   READ(12+VAR) (IDUMMY,J=1,3*N_FACES)
   READ(12+VAR) (IDUMMY,J=1,N_FACES)
   READ(12+VAR) (DUMMY,J=1,6*N_FACES)
ENDIF
IF (N_VOLUS>0) THEN
   READ(12+VAR) (IDUMMY,J=1,4*N_VOLUS)
   READ(12+VAR) (IDUMMY,J=1,N_VOLUS)
ENDIF

! read and save first dynamic frame

READ(12+VAR) TIME
READ(12+VAR) N_VERTS, N_FACES, N_VOLUS 

IF (N_VERTS>0) THEN
  ALLOCATE (VERTS(3,N_VERTS))            
  ALLOCATE (NEWVERTS(3,N_VERTS))     
  READ(12+VAR) VERTS
ENDIF

IF (N_FACES>0) THEN
   ALLOCATE (FACES(N_FACES,3))
   ALLOCATE (SURF_IDS(N_FACES))
   ALLOCATE (TFACES(N_FACES,6))
   READ(12+VAR) FACES
   READ(12+VAR) SURF_IDS
   READ(12+VAR) TFACES
ENDIF
IF (N_VOLUS>0) THEN
   ALLOCATE (VOLUS(N_VOLUS,4))
   ALLOCATE (MATL_IDS(N_VOLUS))
   READ(12+VAR) VOLUS
   READ(12+VAR) MATL_IDS
ENDIF

CLOSE(12+VAR) 

OPEN(12+VAR,FILE=TRIM(CHID)//'.gc',FORM='UNFORMATTED',STATUS='REPLACE')
WRITE(12+VAR) ONE
WRITE(12+VAR) VERSION
NEWVERTS=VERTS
NEWVERTS(3,4)=VERTS(3,4)-(0.1*(TIMEGEOM/2))

WRITE(12+VAR) TIMEGEOM
WRITE(12+VAR) N_VERTS, N_FACES, N_VOLUS 
IF (N_VERTS>0) WRITE(12+VAR) NEWVERTS
IF (N_FACES>0) THEN
  WRITE(12+VAR) FACES
  WRITE(12+VAR) SURF_IDS
  WRITE(12+VAR) TFACES
ENDIF
IF (N_VOLUS>0) THEN
  WRITE(12+VAR) VOLUS
  WRITE(12+VAR) MATL_IDS
ENDIF

CLOSE(12+VAR)
IF (N_VERTS>0) THEN
  DEALLOCATE (VERTS)            
  DEALLOCATE (NEWVERTS)
ENDIF
IF (N_FACES>0) THEN
  DEALLOCATE (FACES)
  DEALLOCATE (SURF_IDS)
  DEALLOCATE (TFACES)
ENDIF
IF (N_VOLUS>0) THEN
  DEALLOCATE (VOLUS)
  DEALLOCATE (MATL_IDS)
ENDIF
ENDDO TIME_LOOP

END PROGRAM TWOWAYCOUPLING_EMULATOR

